home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FILES.SWG / 0053_File and Record Locks.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  4KB  |  172 lines
  1. {
  2. This is a demonstration of a network unit capable of locking
  3. pascal records or any set of bytes on a file.
  4.  
  5. Programmer: Ronen Magid, Qiyat-Ono Israel.
  6. Contributed to the SWAG.
  7. }
  8.  
  9. Unit Network;
  10. Interface
  11. Uses Dos;
  12.  
  13. Var
  14.   Regs       : Registers;
  15.   RegSize    : Byte;
  16.   RecSize    : Longint;
  17.   OffSet     : LongInt;
  18.   FileHandle : word;
  19.  
  20. Const
  21.  SH_COMPAT   =  $0000;
  22.  SH_DENYRW   =  $0010;
  23.  SH_DENYWR   =  $0020;
  24.  SH_DENYRD   =  $0030;
  25.  SH_DENYNONE =        $0040;
  26.  SH_DENYNO   =  SH_DENYNONE;
  27.  O_RDONLY    =  $0;
  28.  O_WRITE     =  $1;
  29.  O_RDWR      =  $2;
  30.  
  31. function  Lock(Var Handle: Word; Var  Offset, BufLen: Longint): Word;
  32. function  Unlock(Var Handle: Word; Var OffSet, BufLen: Longint): Word;
  33.  
  34. Implementation
  35.  
  36. function Lock(var  handle: word; var  offset, buflen: longint): word;
  37. var
  38.   TempOffset:longint;
  39. begin
  40.   Lock := 0;
  41.   TempOffset:=1000000000+Offset;
  42.   fillchar(regs, sizeof(regs), 0);
  43.   regs.ah := $5C; { Lock file access }
  44.   regs.al := 0;
  45.   regs.bx := handle;
  46.   regs.cx := TempOffset shr RegSize; {and $ffff;}
  47.   regs.dx := TempOffset and $ffff;
  48.   regs.si := buflen shr RegSize; {and $ffff;}
  49.   regs.di := buflen and $ffff;
  50.   MsDos(regs);
  51.   if (regs.Flags and 1) <> 0 then
  52.   Lock := regs.ax;
  53. end;
  54.  
  55. function Unlock(var handle: word; var offset, buflen: longint): word;
  56. var
  57.   TempOffset:longint;
  58. begin
  59.   Unlock := 0;
  60.   TempOffset:=1000000000+Offset;
  61.   regs.ah := $5C; { Unlock file access }
  62.   regs.al := 1;
  63.   regs.bx := handle;
  64.   regs.cx := TempOffset shr RegSize; {and $ffff;}
  65.   regs.dx := TempOffset and $ffff;
  66.   regs.si := buflen shr RegSize; {and $ffff;}
  67.   regs.di := buflen and $ffff;
  68.   MsDos(regs);
  69.   if (regs.Flags and 1) <> 0 then
  70.   Unlock := regs.ax;
  71. end;
  72.  
  73. End.
  74.  
  75. { ---------------------     TEST CODE ...   CUT HERE -------------------}
  76.  
  77. {
  78. This demonstartion will show how to use the NETWORK file-lock
  79. unit to allow lock and lock-check of records in a regular
  80. pascal database file.
  81.  
  82. Programmer: Ronen Magid, Qiyat-Ono Israel.
  83. Contributed to the SWAG.
  84. }
  85.  
  86. Program NetTest;
  87. uses Dos,Network;
  88.  
  89. Type
  90.   PhoneRecord = Record
  91.     Name    :  String[30];
  92.     Address :  String[35];
  93.     Phone   :  String[15];
  94.   End;
  95.  
  96. Var
  97.   PhoneRec   : PhoneRecord;
  98.   PhoneFile  : File of PhoneRecord;
  99.   FileHandle : word;
  100.   LockStatus : Word;
  101.   I          : Byte;
  102.   Ok         : Boolean;
  103.  
  104. Function LockPhoneRec(which: LongInt): Boolean;
  105. Begin
  106.   recsize := SizeOf(PhoneRec);
  107.   OffSet :=  RecSize * Which - Recsize;
  108.   FileHandle := FileRec(PhoneFile).handle;
  109.   LockStatus := Lock(FileHandle, offset, recsize);
  110.   if LockStatus = 0 then
  111.   begin
  112.     LockPhoneRec:=True;
  113.   end else
  114.   begin
  115.     LockPhoneRec:=False;
  116.   end;
  117. end;
  118.  
  119. function UnLockPhoneRec(Which: Byte): boolean;
  120. var
  121.   ok:   boolean;
  122. begin
  123.   recsize := SizeOf(PhoneRec);
  124.   OffSet := Which * RecSize - RecSize;
  125.   FileHandle := FileRec(PhoneFile).handle;
  126.   LockStatus := Unlock(FileHandle, offset, recsize);
  127.   if LockStatus <> 0 then
  128.   begin
  129.     UnlockPhoneRec := false;
  130.   end else
  131.   begin
  132.     UnlockPhoneRec := true;
  133.   end;
  134. end;
  135.  
  136. begin
  137.   Assign(Phonefile,'PHONE.SMP');
  138.   Rewrite(Phonefile);
  139.   For I:=1 to 5 do Write(Phonefile,phoneRec);
  140.   Close(Phonefile);
  141.  
  142.   FileMode := SH_DENYNO + O_RDWR;    {Important, Before RESET!}
  143.   Reset(Phonefile);
  144.  
  145.   { And now lets begin to lock... }
  146.  
  147.   Ok:=LockPhoneRec(2);
  148.   {Locking phone rec 2}
  149.  
  150.   {Now lets see if its locked... }
  151.  
  152.   Ok:=LockPhoneRec(2);
  153.   {a record is already locked if we
  154.    cant lock it. This locking procedure
  155.    can be performed by other PCs & other
  156.    tasks.}
  157.  
  158.   If Not Ok then writeln('#2 locked');
  159.  
  160.   Ok:=UnlockPhoneRec(2);
  161.   { lets release it. This will enable
  162.     other tasks or LAN PCs to lock
  163.     (& obtain) this record again...}
  164.  
  165.   If Ok then Writeln('Rec #2 unlocked');
  166.  
  167.   {thats it...}
  168.   Ok:=LockPhoneRec(2);
  169.   If Ok then Writeln('And since its free we can relock it !');
  170.   Close(phoneFile);
  171. End.
  172.